home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / execswap.zip / EXECSWAP.PAS < prev    next >
Pascal/Delphi Source File  |  1989-05-02  |  4KB  |  132 lines
  1. {
  2. Copyright (c) 1988 TurboPower Software
  3. May be used freely as long as due credit is given
  4.  
  5. Version 1.1 - 3/15/89
  6.   save and restore EMS page map
  7. Version 1.2 - 3/29/89
  8.   add more compiler directives (far calls off, boolean short-circuiting)
  9.   add UseEmsIfAvailable to disable EMS usage when desired
  10. Version 1.3 - 5/02/89
  11.   fix problem with exit chain when InitExecSwap/ShutdownExecSwap called
  12.     more than once in a program
  13.   flush swap file before execing
  14. }
  15.  
  16. {$R-,S-,F-,O-,I-,B-}
  17.  
  18. unit ExecSwap;
  19.   {-Memory-efficient DOS EXEC call}
  20. interface
  21.  
  22. const
  23.   UseEmsIfAvailable : Boolean = True;     {True to use EMS if available}
  24.   BytesSwapped : LongInt = 0;             {Bytes to swap to EMS/disk}
  25.   EmsAllocated : Boolean = False;         {True when EMS allocated for swap}
  26.   FileAllocated : Boolean = False;        {True when file allocated for swap}
  27.  
  28. function ExecWithSwap(Path, CmdLine : String) : Word;
  29.   {-DOS EXEC supporting swap to EMS or disk}
  30.  
  31. function InitExecSwap(LastToSave : Pointer; SwapFileName : String) : Boolean;
  32.   {-Initialize for swapping, returning TRUE if successful}
  33.  
  34. procedure ShutdownExecSwap;
  35.   {-Deallocate swap area}
  36.  
  37. implementation
  38.  
  39. var
  40.   EmsHandle : Word;               {Handle of EMS allocation block}
  41.   FrameSeg : Word;                {Segment of EMS page frame}
  42.   FileHandle : Word;              {DOS handle of swap file}
  43.   SwapName : String[80];          {ASCIIZ name of swap file}
  44.   SaveExit : Pointer;             {Exit chain pointer}
  45.  
  46.   {$L EXECSWAP}
  47.   function ExecWithSwap(Path, CmdLine : String) : Word; external;
  48.   procedure FirstToSave; external;
  49.   function AllocateSwapFile : Boolean; external;
  50.   procedure DeallocateSwapFile; external;
  51.  
  52.   {$F+}     {These routines could be interfaced for general use}
  53.   function EmsInstalled : Boolean; external;
  54.   function EmsPageFrame : Word; external;
  55.   function AllocateEmsPages(NumPages : Word) : Word; external;
  56.   procedure DeallocateEmsHandle(Handle : Word); external;
  57.   function DefaultDrive : Char; external;
  58.   function DiskFree(Drive : Byte) : LongInt; external;
  59.  
  60.   procedure ExecSwapExit;
  61.   begin
  62.     ExitProc := SaveExit;
  63.     ShutdownExecSwap;
  64.   end;
  65.   {$F-}
  66.  
  67.   procedure ShutdownExecSwap;
  68.   begin
  69.     if EmsAllocated then begin
  70.       DeallocateEmsHandle(EmsHandle);
  71.       EmsAllocated := False;
  72.     end else if FileAllocated then begin
  73.       DeallocateSwapFile;
  74.       FileAllocated := False;
  75.     end;
  76.   end;
  77.  
  78.   function PtrDiff(H, L : Pointer) : LongInt;
  79.   type
  80.     OS = record O, S : Word; end;   {Convenient typecast}
  81.   begin
  82.     PtrDiff := (LongInt(OS(H).S) shl 4+OS(H).O)-
  83.                (LongInt(OS(L).S) shl 4+OS(L).O);
  84.   end;
  85.  
  86.   function InitExecSwap(LastToSave : Pointer;
  87.                         SwapFileName : String) : Boolean;
  88.   const
  89.     EmsPageSize = 16384;            {Bytes in a standard EMS page}
  90.   var
  91.     PagesInEms : Word;              {Pages needed in EMS}
  92.     BytesFree : LongInt;            {Bytes free on swap file drive}
  93.     DriveChar : Char;               {Drive letter for swap file}
  94.   begin
  95.     InitExecSwap := False;
  96.  
  97.     if EmsAllocated or FileAllocated then
  98.       Exit;
  99.     BytesSwapped := PtrDiff(LastToSave, @FirstToSave);
  100.     if BytesSwapped <= 0 then
  101.       Exit;
  102.  
  103.     if UseEmsIfAvailable and EmsInstalled then begin
  104.       PagesInEms := (BytesSwapped+EmsPageSize-1) div EmsPageSize;
  105.       EmsHandle := AllocateEmsPages(PagesInEms);
  106.       if EmsHandle <> $FFFF then begin
  107.         EmsAllocated := True;
  108.         FrameSeg := EmsPageFrame;
  109.         if FrameSeg <> 0 then begin
  110.           InitExecSwap := True;
  111.           Exit;
  112.         end;
  113.       end;
  114.     end;
  115.     if Length(SwapFileName) <> 0 then begin
  116.       SwapName := SwapFileName+#0;
  117.       if Pos(':', SwapFileName) = 2 then
  118.         DriveChar := Upcase(SwapFileName[1])
  119.       else
  120.         DriveChar := DefaultDrive;
  121.       BytesFree := DiskFree(Byte(DriveChar)-$40);
  122.       FileAllocated := (BytesFree > BytesSwapped) and AllocateSwapFile;
  123.       if FileAllocated then
  124.         InitExecSwap := True;
  125.     end;
  126.   end;
  127.  
  128. begin
  129.   SaveExit := ExitProc;
  130.   ExitProc := @ExecSwapExit;
  131. end.
  132.